unit main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Menus,
  Vcl.ExtDlgs, Vcl.Imaging.PNGimage, VCL.Imaging.JPEG, VCL.Imaging.GIFImg,
  Vcl.ComCtrls;

type
  TMainForm = class(TForm)
    MainMenu: TMainMenu;
    File1: TMenuItem;
    Save1: TMenuItem;
    Exit1: TMenuItem;
    ScrollBox: TScrollBox;
    BitmapFontImage: TImage;
    Label1: TLabel;
    FontList: TComboBox;
    SavePictureDialog: TSavePictureDialog;
    Label2: TLabel;
    SizeEdit: TEdit;
    SizeUpDown: TUpDown;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    TextColour: TShape;
    Label4: TLabel;
    BackgroundColour: TShape;
    ColorDialog: TColorDialog;
    procedure FormCreate(Sender: TObject);
    procedure OnChangeFont(Sender: TObject);
    procedure OnExit(Sender: TObject);
    procedure OnSave(Sender: TObject);
    procedure OnSizeChanging(Sender: TObject; var AllowChange: Boolean);
    procedure OnSizeChange(Sender: TObject);
    procedure OnChangeTextColour(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure OnChangeBackgroundColour(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    m_bitmap: TBitmap;
    m_size: integer;
    m_textColour: TColor;
    m_backgroundColour: TColor;

    function CreateBitmapFont(const name: string; size: integer; text, background: TColor): TBitmap;
    procedure ChangeSettings;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FontList.Items.Assign(Screen.Fonts);
  FontList.ItemIndex := 0;
  m_size := 16;
  m_textColour := clWhite;
  m_backgroundColour := clBlack;
  BackgroundColour.Brush.Color := m_backgroundColour;
  m_bitmap := CreateBitmapFont(FontList.Items[FontList.ItemIndex], m_size, m_textColour, m_backgroundColour);
  BitmapFontImage.Picture.Bitmap := m_bitmap;
end;

procedure TMainForm.OnChangeBackgroundColour(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ColorDialog.Color := m_backgroundColour;
  if ColorDialog.Execute then
  begin
    m_backgroundColour := ColorDialog.Color;
    BackgroundColour.Brush.Color := m_backgroundColour;
    ChangeSettings;
  end;
end;

procedure TMainForm.OnChangeFont(Sender: TObject);
begin
  ChangeSettings;
end;

procedure TMainForm.OnChangeTextColour(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ColorDialog.Color := m_textColour;
  if ColorDialog.Execute then
  begin
    m_textColour := ColorDialog.Color;
    TextColour.Brush.Color := m_textColour;
    ChangeSettings;
  end;
end;

procedure TMainForm.OnExit(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.OnSave(Sender: TObject);
begin
  if SavePictureDialog.Execute then
    m_bitmap.SaveToFile(SavePictureDialog.FileName);
end;

procedure TMainForm.OnSizeChange(Sender: TObject);
begin
  m_size := StrToInt(SizeEdit.Text);
  ChangeSettings;
end;

procedure TMainForm.OnSizeChanging(Sender: TObject; var AllowChange: Boolean);
begin
  m_size := StrToInt(SizeEdit.Text);
  ChangeSettings;
  AllowChange := true;
end;

procedure TMainForm.ChangeSettings;
begin
  m_bitmap.Free;
  m_bitmap := CreateBitmapFont(FontList.Items[FontList.ItemIndex], m_size, m_textColour, m_backgroundColour);
  BitmapFontImage.Picture.Bitmap := m_bitmap;
end;

function TMainForm.CreateBitmapFont(const name: string; size: integer; text, background: TColor): TBitmap;
var
  i, x, y: integer;
  buffer: array [0..1] of char;

begin
  m_bitmap := TBitmap.Create;
  m_bitmap.PixelFormat := pf8bit;
  m_bitmap.Width := 32 * 16;
  m_bitmap.Height := 16 * 16;
  m_bitmap.Canvas.Brush.Color := background;
  m_bitmap.Canvas.FillRect(Rect(0, 0, 32 * 16, 32 * 16));
  m_bitmap.Canvas.Font.Name := name;
  m_bitmap.Canvas.Font.Size := size;
  m_bitmap.Canvas.Font.Color := text;
  buffer[0] := chr(0);
  buffer[1] := chr(0);

  for i := 32 to 128 do
  begin
    buffer[0] := chr(i);
    x := ((i - 32) mod 16) * 32;
    y := ((i - 32) div 16) * 32;
    m_bitmap.Canvas.TextOut(x, y, buffer);
  end;

  result := m_bitmap;
end;

end.
